home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / tpascal / vbdll / dllform.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-28  |  5KB  |  172 lines
  1. unit Dllform;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls,
  6.   Buttons, SysUtils, StdCtrls,VBAPI;
  7.  
  8. type
  9.   TPasswordForm = class(TForm)
  10.     Edit1: TEdit;
  11.     Label1: TLabel;
  12.     BitBtn2: TBitBtn;
  13.     BitBtn1: TBitBtn;
  14.   end;
  15.  
  16. function GetPassword(Password: PChar): Integer; export;
  17. function RTrimStr(VBStrHLSTR: HLStr):  HLStr; export;
  18. Function GetDirEntries(hlstrPath: HLSTR; hadDirInfoArray: HAD): Integer;  export;
  19. function MinInt(X, Y: Integer): Integer; export;
  20. function MaxInt(X, Y: Integer): Integer; export;
  21.  
  22.  
  23. implementation
  24.  
  25. uses Dialogs;
  26.  
  27. {$R *.DFM}
  28.  
  29.  
  30. const
  31.     VBTrue=-1;
  32.    VBFalse=0;
  33.  
  34.  
  35. function GetPassword(Password: PChar): Integer;
  36. var
  37.   PasswordForm: TPasswordForm;
  38. begin
  39.   Result := VBFalse;
  40.   PasswordForm := TPasswordForm.Create(Application);
  41.   try
  42.     with PasswordForm do
  43.         if PasswordForm.ShowModal = mrOK then
  44.         if UpperCase(Edit1.Text) <> UpperCase(StrPas(Password)) then
  45.               MessageDlg('Invalid Password', mtWarning, [mbOK], 0)
  46.         else
  47.               Result := VBTrue;
  48.   finally
  49.     PasswordForm.Free;
  50.   end;
  51. end;
  52.  
  53.  
  54. function RTrimStr(VBStrHLSTR: HLStr):  HLStr;
  55. var
  56.     i: Integer;
  57.     TrimStr: PChar;
  58.     VBStrLng: Word;
  59.     strBuf: array[0..19]of char;
  60.  
  61. begin
  62.     TrimStr := VBDerefHlstrLen(VBStrHLSTR,VBStrLng);
  63.     if VBStrLng>0 then
  64.         begin
  65.             for i := VBStrLng-1 downto 0 do begin
  66.                 if TrimStr[i] <> ' ' then begin
  67.                     TrimStr[i+1] := #0;
  68.                     RTrimStr := VBCreateTempHLSTR(TrimStr, i);
  69.                     Exit
  70.                 end;
  71.             end;
  72.         end
  73.      else
  74.         RTrimStr := VBStrHLSTR;
  75. End;
  76.  
  77.  
  78. Function GetDirEntries(hlstrPath: HLSTR; hadDirInfoArray: HAD): Integer;
  79.  
  80. type
  81.     tVBFileInfoRec=record
  82.       Name: array[1..12] of char;
  83.        Size: longint;
  84.        Date: array[1..8] of char;
  85.        Time: array[1..8] of char;
  86.     end;
  87.     tVBArray=array[1..(65520 div SizeOf(tVBFileInfoRec))] of tVBFileInfoRec;
  88.  
  89. var
  90.    SearchPath: String;
  91.    FileInfoRec: TSearchRec;
  92.    ArrayBounds: Longint;
  93.    LowBound, HighBound: Integer;
  94.     NoVBArrayIndexes: Integer;
  95.    NoArrayElems: Integer;
  96.    NoVBFileInfoElements: word;
  97.    ErrorCd: Integer;
  98.     FirstArrayElemPtr: Pointer;
  99.    VBArray: ^tVBArray;
  100.  
  101.     Procedure AddElementToVBArray( var FileInfoRec: TSearchRec);
  102.     var
  103.        strDate: string[8];
  104.            strTime: string[8];
  105.        FileDateTime: TDateTime;
  106.        VBFileInfoRec: tVBFileInfoRec;
  107.  
  108.     begin
  109.           {Get the File Name}
  110.        FillChar(VBFileInfoRec.Name, SizeOf(VBFileInfoRec.Name),' ');
  111.         Move( FileInfoRec.Name[1], VBFileInfoRec.Name[1], Length(FileInfoRec.Name));
  112.  
  113.            {Get the File Size}
  114.            VBFileInfoRec.Size := FileInfoRec.Size;
  115.  
  116.            {Get the Date}
  117.            FileDateTime:= FileDateToDateTime(FileInfoRec.Time);
  118.            strDate := FormatDateTime('dd\mm\yy', FileDateTime);
  119.            strTime :=  FormatDateTime('HH:MM am/pm', FileDateTime);
  120.            Move( strDate[1],VBFileInfoRec.Date, SizeOf(VBFileInfoRec.Date));
  121.            Move( strTime[1],VBFileInfoRec.Time, SizeOf(VBFileInfoRec.Time));
  122.  
  123.            inc(NoVBFileInfoElements);
  124.            VBArray^[NoVBFileInfoElements]:=VBFileInfoRec;
  125.     end;
  126.  
  127. begin
  128.    {Initilize}
  129.    NoVBFileInfoElements:= 0;
  130.  
  131.     {Get Path}
  132.    SearchPath := StrPas(VBDerefZeroTermHlstr(hlstrPath));
  133.  
  134.     {Get No Array Elements}
  135.     NoVBArrayIndexes:= VBArrayIndexCount(hadDirInfoArray);  {This isn't used in this example dll}
  136.     ArrayBounds:=VBArrayBounds(hadDirInfoArray,1);
  137.     LowBound := LoWord(ArrayBounds);
  138.     HighBound:=HiWord(ArrayBounds);
  139.     NoArrayElems:= HighBound - LowBound + 1;
  140.    {MessageDlg('NoArrayElems:'+ IntToStr(NoArrayElems), mtInformation, [mbOK], 0);}
  141.  
  142.     {Pointing the VBArray Address to the first element address in the passed VB Array}
  143.    VBArray:= VBArrayFirstElem(hadDirInfoArray);
  144.  
  145.     {Read the Directory}
  146.     ErrorCd:= FindFirst(SearchPath,(faAnyFile-faDirectory), FileInfoRec);
  147.    While (ErrorCd=0) and (NoVBFileInfoElements < NoArrayElems) do begin
  148.         AddElementToVBArray(FileInfoRec);
  149.         ErrorCd:= FindNext(FileInfoRec);
  150.     end; {While}
  151.  
  152.    {This MessageDlg can't happen because the above loop kicks out before finishing all selected files}
  153.    If NoVBFileInfoElements > NoArrayElems then begin
  154.         MessageDlg('No Files in selected TSearchRec > No VB Array size of:'+ IntToStr(NoArrayElems), mtWarning, [mbOK], 0);
  155.    end;
  156.   GetDirEntries:= NoVBFileInfoElements
  157.  
  158. end;
  159.  
  160.  
  161. function MinInt(X, Y: Integer): Integer;
  162.   begin
  163.     if X < Y then MinInt := X else MinInt := Y;
  164.   end;
  165.  
  166. function MaxInt(X, Y: Integer): Integer;
  167.   begin
  168.     if X > Y then MaxInt := X else MaxInt := Y;
  169.   end;
  170.  
  171. end.
  172.